home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / table.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  8.1 KB  |  341 lines  |  [TEXT/ttxt]
  1. /*
  2.  
  3.    table.c
  4.  
  5.    This software is free software; you can redistribute it and/or
  6.    modify it under the terms of the GNU Library General Public
  7.    License as published by the Free Software Foundation; either
  8.    version 2 of the License, or (at your option) any later version.
  9.  
  10.    This software is distributed in the hope that it will be useful,
  11.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13.    Library General Public License for more details.
  14.  
  15.    You should have received a copy of the GNU Library General Public
  16.    License along with this software; if not, write to the Free
  17.    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19.    Original copyright notice follows:
  20.  
  21.    Copyright, 1993, Brent Benson.  All Rights Reserved.
  22.    0.4 & 0.5 Revisions Copyright 1994, Joseph N. Wilson.  All Rights Reserved.
  23.  
  24.    Permission to use, copy, and modify this software and its
  25.    documentation is hereby granted only under the following terms and
  26.    conditions.  Both the above copyright notice and this permission
  27.    notice must appear in all copies of the software, derivative works
  28.    or modified version, and both notices must appear in supporting
  29.    documentation.  Users of this software agree to the terms and
  30.    conditions set forth in this notice.
  31.  
  32.  */
  33.  
  34. #include <string.h>
  35.  
  36. #include "table.h"
  37.  
  38. #include "alloc.h"
  39. #include "apply.h"
  40. #include "collection.h"
  41. #include "error.h"
  42. #include "list.h"
  43. #include "number.h"
  44. #include "prim.h"
  45. #include "symbol.h"
  46.  
  47. extern Object dylan_symbol;
  48.  
  49. /* local function prototypes */
  50.  
  51. static Object *table_element_handle (Object table,
  52.                      Object key,
  53.                      Object *default_val);
  54. static Object table_initial_state (Object table);
  55. static Object table_next_state (Object table, Object state);
  56. static Object table_current_element (Object table, Object state);
  57. static Object table_current_key (Object table, Object state);
  58. static Object table_current_element_setter (Object table, Object state, Object value);
  59. static Object equal_hash (Object key);
  60. static Object hash_pair (Object pair);
  61. static Object hash_deque (Object deq);
  62. static Object hash_string (Object string);
  63. static Object hash_vector (Object vector);
  64.  
  65. static Object table_default = NULL;
  66.  
  67. /* primitives */
  68.  
  69. static struct primitive table_prims[] =
  70. {
  71.     {"%table-element", prim_3, table_element},
  72.     {"%table-element-setter", prim_3, table_element_setter},
  73.     {"%table-initial-state", prim_1, table_initial_state},
  74.     {"%table-next-state", prim_2, table_next_state},
  75.     {"%table-current-element", prim_2, table_current_element},
  76.     {"%table-current-key", prim_2, table_current_key},
  77.     {"%table-current-element-setter", prim_3, table_current_element_setter},
  78.     {"%=hash", prim_1, equal_hash},
  79. };
  80.  
  81. void
  82. init_table_prims (void)
  83. {
  84.     int num;
  85.  
  86.     num = sizeof (table_prims) / sizeof (struct primitive);
  87.  
  88.     init_prims (num, table_prims);
  89.     table_default = cons (false_object, false_object);
  90. }
  91.  
  92. Object
  93. make_table (int size)
  94. {
  95.     Object obj;
  96.  
  97.     obj = allocate_object (sizeof (struct table));
  98.  
  99.     TABLETYPE (obj) = ObjectTable;
  100.     TABLESIZE (obj) = size;
  101.     TABLETABLE (obj) = (Object *) checking_malloc (sizeof (Object) * size);
  102.     memset (TABLETABLE (obj), 0, sizeof (Object) * size);
  103.  
  104.     return (obj);
  105. }
  106.  
  107. Object
  108. make_table_entry (int row, Object key, Object value, Object next)
  109. {
  110.     Object obj;
  111.  
  112.     obj = allocate_object (sizeof (struct table_entry));
  113.  
  114.     TETYPE (obj) = TableEntry;
  115.     TEROW (obj) = row;
  116.     TEKEY (obj) = key;
  117.     TEVALUE (obj) = value;
  118.     TENEXT (obj) = next;
  119.     return (obj);
  120. }
  121.  
  122. Object
  123. make_table_driver (Object rest)
  124. {
  125.     Object size;
  126.  
  127.     if (NULLP (rest)) {
  128.     return (make_table (DEFAULT_TABLE_SIZE));
  129.     } else if (CAR (rest) == size_keyword) {
  130.     rest = CDR (rest);
  131.     if (NULLP (rest)) {
  132.         error ("make: no argument given to size keyword", NULL);
  133.     }
  134.     size = CAR (rest);
  135.     if (!INTEGERP (size)) {
  136.         error ("make: argument to size keyword must be an integer", size, NULL);
  137.     }
  138.     return (make_table (INTVAL (size)));
  139.     } else {
  140.     error ("make: bad keywords or arguments", rest, NULL);
  141.     }
  142. }
  143.  
  144. /* local functions */
  145.  
  146. Object
  147. table_element (Object table, Object key, Object default_val)
  148. {
  149.     return *table_element_handle (table, key, &default_val);
  150. }
  151.  
  152. static Object *
  153. table_element_handle (Object table, Object key, Object *default_val)
  154. {
  155.     Object hval, equal_fun, entry;
  156.     int h, old;
  157.     struct frame *old_env;
  158.  
  159.     hval = equal_hash (key);
  160.     h = INTVAL (hval) % TABLESIZE (table);
  161.     entry = TABLETABLE (table)[h];
  162.  
  163.     old_env = the_env;
  164.     the_env = module_binding (dylan_symbol)->namespace;
  165.     equal_fun = symbol_value (equal_symbol);
  166.     the_env = old_env;
  167.  
  168.     while (entry) {
  169.     if (apply (equal_fun,
  170.            cons (TEKEY (entry), cons (key, make_empty_list ())))
  171.         != false_object) {
  172.         return &(TEVALUE (entry));
  173.     }
  174.     entry = TENEXT (entry);
  175.     }
  176.     if (*default_val != default_object) {
  177.     return default_val;
  178.     } else {
  179.     error ("element: no element matching key", key, NULL);
  180.     }
  181. }
  182.  
  183.  
  184. Object
  185. table_element_setter (Object table, Object key, Object val)
  186. {
  187.     Object hval, entry;
  188.     Object *element_handle;
  189.     int h;
  190.  
  191.     if ((element_handle = table_element_handle (table, key, &table_default))
  192.     != &table_default) {
  193.     *element_handle = val;
  194.     } else {
  195.     hval = equal_hash (key);
  196.     h = INTVAL (hval) % TABLESIZE (table);
  197.     entry = make_table_entry (h, key, val, TABLETABLE (table)[h]);
  198.     TABLETABLE (table)[h] = entry;
  199.     }
  200.     return (unspecified_object);
  201. }
  202.  
  203. /* iteration protocol */
  204.  
  205. static Object
  206. table_initial_state (Object table)
  207. {
  208.     int i;
  209.  
  210.     for (i = 0; i < TABLESIZE (table); ++i) {
  211.     if (TABLETABLE (table)[i]) {
  212.         return (TABLETABLE (table)[i]);
  213.     }
  214.     }
  215.     return (false_object);
  216. }
  217.  
  218. static Object
  219. table_next_state (Object table, Object state)
  220. {
  221.     int i;
  222.  
  223.     if (TENEXT (state)) {
  224.     return (TENEXT (state));
  225.     }
  226.     for (i = (TEROW (state) + 1); i < TABLESIZE (table); ++i) {
  227.     if (TABLETABLE (table)[i]) {
  228.         return (TABLETABLE (table)[i]);
  229.     }
  230.     }
  231.     return (false_object);
  232. }
  233.  
  234. static Object
  235. table_current_element (Object table, Object state)
  236. {
  237.     return (TEVALUE (state));
  238. }
  239.  
  240. static Object
  241. table_current_key (Object table, Object state)
  242. {
  243.     return (TEKEY (state));
  244. }
  245.  
  246. static Object
  247. table_current_element_setter (Object table, Object state, Object value)
  248. {
  249.     TEVALUE (state) = value;
  250.     return (unspecified_object);
  251. }
  252.  
  253. static Object
  254. equal_hash (Object key)
  255. {
  256.     Object hashfun;
  257.  
  258.     if (INSTANCEP (key)) {
  259.     hashfun = symbol_value (equal_hash_symbol);
  260.     /*
  261.      * Need to be able to hash arbitrary instances here!
  262.      */
  263.     if (!hashfun) {
  264.         error ("no =hash method defined for key class", key, NULL);
  265.     }
  266.     return (apply (hashfun, cons (key, make_empty_list ())));
  267.     } else {
  268.     if (INTEGERP (key)) {
  269.         return (key);
  270.     } else if (CHARP (key)) {
  271.         return (make_integer (CHARVAL (key)));
  272.     } else if (TRUEP (key)) {
  273.         return (make_integer (1));
  274.     } else if (FALSEP (key)) {
  275.         return (make_integer (0));
  276.     } else if (NULLP (key)) {
  277.         return (make_integer (2));
  278.     } else if (PAIRP (key)) {
  279.         return (hash_pair (key));
  280.     } else if (DEQUEP (key)) {
  281.         return (hash_deque (key));
  282.     } else if (BYTESTRP (key)) {
  283.         return (hash_string (key));
  284.     } else if (SOVP (key)) {
  285.         return (hash_vector (key));
  286.     } else if (SYMBOLP (key) || KEYWORDP (key)) {
  287.         return (make_integer ((int) key));
  288.     } else {
  289. /*          error ("=hash: don't know how to hash object", key, NULL);  */
  290.         return (make_integer (((int) key)));
  291.     }
  292.     }
  293. }
  294.  
  295. static Object
  296. hash_pair (Object pair)
  297. {
  298.     int h;
  299.  
  300.     h = INTVAL (equal_hash (CAR (pair))) + INTVAL (equal_hash (CDR (pair)));
  301.     return (make_integer (h));
  302. }
  303.  
  304. static Object
  305. hash_deque (Object deq)
  306. {
  307.     int h = 0;
  308.     Object entry;
  309.  
  310.     entry = DEQUEFIRST (deq);
  311.     while (!EMPTYLISTP (entry)) {
  312.     h += INTVAL (equal_hash (DEVALUE (entry)));
  313.     entry = DENEXT (entry);
  314.     }
  315.     return (make_integer (h));
  316. }
  317.  
  318. static Object
  319. hash_string (Object string)
  320. {
  321.     int i, h;
  322.  
  323.     h = 0;
  324.     for (i = 0; i < BYTESTRSIZE (string); ++i) {
  325.     h += BYTESTRVAL (string)[i];
  326.     }
  327.     return (make_integer (h));
  328. }
  329.  
  330. static Object
  331. hash_vector (Object vector)
  332. {
  333.     int i, h;
  334.  
  335.     h = 0;
  336.     for (i = 0; i < SOVSIZE (vector); ++i) {
  337.     h += INTVAL (equal_hash (SOVELS (vector)[i]));
  338.     }
  339.     return (make_integer (h));
  340. }
  341.